home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TIMING.SWG / 0029_Hi resolution Delay number of seconds.pas < prev   
Pascal/Delphi Source File  |  1995-02-28  |  4KB  |  109 lines
  1.  (*****************    W A I T   *************************
  2.  * Delays NumberOfSecs seconds.  This is done by         *
  3.  * accessing the PC clock via function $2C of DOS int    *
  4.  * 21h.  Its accuracy is limited by the fact that the    *
  5.  * time is calculated from the ROM BIOS tick count,      *
  6.  * which is updated only about 18.2 times per second.    *
  7.  * This means that Wait will be accurate to about        *
  8.  * 1/18 second.                                          *
  9.  *                                                       *
  10.  * Requires "Uses DOS" if in TP4 or TP5                  *
  11.  ******************    W A I T   ************************)
  12.  
  13.   uses dos, TpCrt, TpString;
  14.  
  15.   var
  16.     p_cnt : integer;
  17.     s     : string[5];
  18.     sr    : real;
  19.     okay  : boolean;
  20.     ch    : char;
  21.  
  22.  
  23.   PROCEDURE Wait(NumberOfSecs : Real);
  24.   CONST
  25.     Secs_PER_DAY = 86400.0; {60 * 60 * 24}
  26.   VAR
  27.     TimeIsUp : Boolean;
  28.     StartingSecs,
  29.     Secs : Real;
  30.  
  31.     (******************   READ CLOCK  ************************
  32.     *                                                        *
  33.     *  Reads the PC clock, by using service $2C of int 21h.  *
  34.     *  This service returns information in the 8088          *
  35.     *  registers as follows:                                 *
  36.     *                                                        *
  37.     *    CH      Hour                  (0 through 23)        *
  38.     *    CL      Minute                (0 through 59)        *
  39.     *    DH      Seconds               (0 through 59)        *
  40.     *    DL      Hundredths of seconds (0 through 99)        *
  41.     *******************   READ CLOCK  ***********************)
  42.  
  43.     PROCEDURE ReadClock(VAR Secs : Real);
  44.  
  45.     CONST
  46.       Secs_PER_HOUR = 3600.0; {This must be a real constant!}
  47.       Secs_PER_MINUTE = 60.0;
  48. (*  TYPE {Delete this type for TP4 and TP5}
  49.       Registers = RECORD
  50.         CASE Boolean OF
  51.           True : (AL,AH,BL,BH,CL,CH,DL,DH:Byte);
  52.           False : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:Integer)
  53.         END;  *)
  54.     VAR Regs : Registers;
  55.     BEGIN
  56.       Regs.AH := $2C;
  57.       msDos(Regs);
  58.       Secs := Secs_PER_HOUR*(Regs.CH)
  59.                 +Secs_PER_MINUTE*(Regs.CL)
  60.                 +Regs.DH
  61.                 +0.01*Regs.DL;
  62.     END;
  63.  
  64. { BODY OF WAIT procedure}
  65.  
  66.   BEGIN
  67.     ReadClock(StartingSecs);
  68.     REPEAT                                  { allow break out }
  69.       if KeyPressed then begin
  70.                            ch := ReadKey;   { eat the key }
  71.                            Halt;
  72.                          end;
  73.       ReadClock(Secs);
  74.       IF Secs-StartingSecs >= 0.0 THEN {Normal situation.}
  75.         TimeIsUp := Secs-StartingSecs >= NumberOfSecs
  76.       ELSE {During call, clock has ticked past midnight.}
  77.         TimeIsUp := Secs_PER_DAY-StartingSecs+Secs >= NumberOfSecs
  78.     UNTIL TimeIsUp
  79.   END;
  80.  
  81.  
  82. {  M _ A _ I _ N  }
  83.  
  84.   begin
  85.  
  86.     p_cnt := paramcount;
  87.     if p_cnt = 0 then begin
  88.       writeln('WAIT - a utility to wait a set number of seconds.');
  89.       writeln('     - Is machine speed independent because it uses dos int 21h, function $2C.');
  90.       writeln('     - can wait up to a whole day with a count of 86400.');
  91.       writeln('     - can be interupted at any time by pressing a keyboard key.');
  92.       writeln('     - needs a command line argument of number of seconds to wait.');
  93.       writeln('     - IE. "wait 300" would wait for 5 minutes and then continue.');
  94.       halt;
  95.     end else begin
  96.       s := paramstr(1);
  97.       okay := false;
  98.       okay := Str2Real(s, sr);
  99.       if okay then begin
  100.         writeln('WAIT - is now running for ', s ,' seconds.');
  101.         wait(sr);
  102.       end else
  103.         writeln('WAIT - could not run because the parameter was invalid.');
  104.     end;
  105.  
  106.   end.
  107.  
  108.  
  109.